# Importo el df de resultadosTokyo tras el EDA realizado:
resultadosTokyo2025 <- readRDS("resultadosTokyo2025.rds")
# Importo las librerías necesarias:
source("librerias.R")
library(caret)
library(rsample)1 Importacion de librerías y datos
2 Análisis de Componentes Principales
El Análisis de Componentes Principales (PCA, por sus siglas en inglés Principal Component Analysis) es una técnica de reducción de dimensionalidad no supervisada que transforma un conjunto de variables correlacionadas en un conjunto más pequeño de variables no correlacionadas llamadas componentes principales.
2.1 PCA sobre ritmos de carrera a través de los parciales
En esta sección se realiza un Análisis de Componentes Principales (PCA) para la categoría Élite. Se utilizan los tiempos reales de cada segmento de 5km junto con el segmento de 40km a meta, calculados a partir de los tiempos acumulados proporcionados en los parciales. A través de ellos, se dividirá cada parcial por el tiempo final del corredor con el objetivo de captar el porcentaje de tiempo que dedica a cada segmento durante la carrera. Por último y antes de iniciar el PCA, estandarizamos los datos para asegurar que los parciales de 5km y el de 2.195 km tengan la misma importancia en el análisis.
2.1.1 Preparación de datos
# Filtrar por categoría Élite
elite <- resultadosTokyo2025 %>%
filter(categoria == "Élite")
# Calcular parciales reales (tiempos de cada segmento)
elite <- elite %>%
mutate(
seg_0_5 = parcial_5km,
seg_5_10 = parcial_10km - parcial_5km,
seg_10_15 = parcial_15km - parcial_10km,
seg_15_20 = parcial_20km - parcial_15km,
seg_20_25 = parcial_25km - parcial_20km,
seg_25_30 = parcial_30km - parcial_25km,
seg_30_35 = parcial_35km - parcial_30km,
seg_35_40 = parcial_40km - parcial_35km,
seg_40_meta = tiempo_oficial - parcial_40km
)
# Normalizar por tiempo oficial (porcentaje de tiempo en cada segmento)
elite <- elite %>%
mutate(
rel_seg_0_5 = seg_0_5 / tiempo_oficial,
rel_seg_5_10 = seg_5_10 / tiempo_oficial,
rel_seg_10_15 = seg_10_15 / tiempo_oficial,
rel_seg_15_20 = seg_15_20 / tiempo_oficial,
rel_seg_20_25 = seg_20_25 / tiempo_oficial,
rel_seg_25_30 = seg_25_30 / tiempo_oficial,
rel_seg_30_35 = seg_30_35 / tiempo_oficial,
rel_seg_35_40 = seg_35_40 / tiempo_oficial,
rel_seg_40_meta = seg_40_meta / tiempo_oficial
)
# Seleccionar solo las variables para PCA
elite_pca_data <- elite %>%
select(Nombre, Genero, estrategia, starts_with("rel_seg_")) %>%
na.omit()
cat("✓ Datos preparados para categoría Élite\n")✓ Datos preparados para categoría Élitecat("✓ Número de corredores:", nrow(elite_pca_data), "\n")✓ Número de corredores: 92 cat("✓ Variables:", ncol(elite_pca_data) - 3, "segmentos normalizados\n")✓ Variables: 9 segmentos normalizados2.1.2 Análisis de Componentes Principales
# Realizar PCA (sin incluir las columnas Nombre, Genero, Estrategia)
pca_elite <- prcomp(elite_pca_data[, -c(1:3)], center = TRUE, scale. = TRUE)
# Resumen
cat("\n=== RESUMEN PCA - ÉLITE ===\n")
=== RESUMEN PCA - ÉLITE ===print(summary(pca_elite))Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6 PC7
Standard deviation 2.2191 1.5855 0.84810 0.61372 0.44565 0.33824 0.31198
Proportion of Variance 0.5472 0.2793 0.07992 0.04185 0.02207 0.01271 0.01081
Cumulative Proportion 0.5472 0.8265 0.90642 0.94827 0.97034 0.98305 0.99386
PC8 PC9
Standard deviation 0.23502 1.921e-15
Proportion of Variance 0.00614 0.000e+00
Cumulative Proportion 1.00000 1.000e+00# Autovalores
autovalores_elite <- pca_elite$sdev^2
cat("\n=== AUTOVALORES ===\n")
=== AUTOVALORES ===print(autovalores_elite)[1] 4.924559e+00 2.513934e+00 7.192802e-01 3.766523e-01 1.986049e-01
[6] 1.144044e-01 9.733314e-02 5.523221e-02 3.690119e-30# Varianza explicada
var_explicada <- round(autovalores_elite / sum(autovalores_elite) * 100, 2)
cat("\n=== VARIANZA EXPLICADA POR COMPONENTE (%) ===\n")
=== VARIANZA EXPLICADA POR COMPONENTE (%) ===print(var_explicada)[1] 54.72 27.93 7.99 4.19 2.21 1.27 1.08 0.61 0.00# Varianza acumulada
var_acum_elite <- cumsum(var_explicada)
cat("\n=== VARIANZA ACUMULADA (%) ===\n")
=== VARIANZA ACUMULADA (%) ===print(var_acum_elite)[1] 54.72 82.65 90.64 94.83 97.04 98.31 99.39 100.00 100.00Observamos que, con las 2 primeras componentes principales, se explica un 82.65% de la varianza total, lo que indica que estas dos componentes capturan la mayor parte de la información contenida en los datos originales.
2.1.3 Autovectores (Loadings)
A continuación, visualizamos los autovectores (loadings) correspondientes a las dos primeras componentes principales:
cat("=== AUTOVECTORES - PC1 y PC2 ===\n")=== AUTOVECTORES - PC1 y PC2 ===print(pca_elite$rotation[, 1:2]) PC1 PC2
rel_seg_0_5 -0.3735426 -0.1912469
rel_seg_5_10 -0.3997243 -0.2086332
rel_seg_10_15 -0.4248876 -0.1053469
rel_seg_15_20 -0.3963012 0.1357340
rel_seg_20_25 -0.1636699 0.5122632
rel_seg_25_30 0.1295767 0.5315866
rel_seg_30_35 0.3009107 0.3113988
rel_seg_35_40 0.3879472 -0.2821189
rel_seg_40_meta 0.2801323 -0.4108733Observamos que la primera componente principal (PC1) contiene una especie de media ponderada en la cual, se dan valores negativos de manera creciente a medida que avanzan los segmentos de la carrera. A partir de los 20km el valor absoluto de la PC1 se reduce de forma notable y vuelve a incrementar en los tramos de los 30km y los 35km. Un mayor valor absoluto en los parciales hasta los 20km y en los tramos 30-35km y 35-40km sugiere que para esta primera componente principal esos tramos son los más influyentes.
En cuanto a los signos, son todos negativos hasta los 25km, momento a partir del cual los siguientes segmentos comienzan a tomar valores positivos de manera incremental, bajando un poco el valor del segmento desde los 40km a meta. Esto significa que si se proyecta la PC1 sobre un atleta y este tiene un mayor porcentaje de tiempo normalizado en el primer tramo de la carrera, su PC1 tenderá a bajar. Si por el contrario, tiene un mayor porcentaje de tiempo normalizado en el último tramo, con valor positivo, su PC1 tenderá a subir.
A partir de aquí se deduce que los atletas que tengan un PC1 más bajo habrán pasado más porcentaje de tiempo relativo en los tramos iniciales que en los finales en comparación con el promedio (comienzo más lento y final más rápido). Los que tengan un PC1 más alto habrán pasado menos porcentaje de tiempo relativo en los tramos iniciales que en los finales en comparación con el promedio (comienzo más rápido y final más lento).
Para facilitar la comprensión del análisis, esta primera componente puede recibir el nombre de comienzo-fin de la carrera.
Importante
No se está haciendo referencia a tiempos ni ritmos absolutos, sino a la distribución del porcentaje de tiempo de las carreras individuales. Un atleta puede haber emepezado más rápido en términos absolutos pero tener un valor de PC1 más bajo porque, por su propia distribución del ritmo a lo largo de la carrera, ha pasado un porcentaje de tiempo mayor en el primer tramo. De igual forma, un atleta puede haber pasado un porcentaje de tiempo menor en el primer tramo de la carrera (en comparación con el resto de porcentajes de su carrera), y por ello tener un valor de PC1 más alto, pero su ritmo en términos absolutos puede ser más lento que el de otros corredores.
Respecto a la segunda componente principal (PC2), se observan valores ligeramente negativos en los 3 primeros segmentos de la carrera, seguido de valores altamente positivos en los parciales de 20 a 30km y valores negativos en los dos últimos segmentos.
Los valores altos en los segmentos intermedios indican que estos son los tramos que más influyen en la PC2. Los símbolos negativo y positivo reflejan que los tramos iniciales (0-5, 5-10 y 10-15) y finales (35-40 y 40-meta) tienden a bajar el valor de la PC2 mientras que los tramos intermedios (15-20, 20-25, 25-30, 30-35) tienden a subirlo.
Al igual que se hizo con la PC1, si se proyectara la PC2 sobre un atleta y este hubiera pasado un porcentaje de tiempo relativo mayor en los tramos intermedios, tendría un valor de PC2 más alto que si hubiera pasado un porcentaje de tiempo relativo mayor en los tramos iniciales y finales.
La deducción que se obtiene de esta proyección es que los atletas que tienen un valor de PC2 alto han empleado un porcentaje de tiempo relativo mayor en los tramos intermedios en comparación con el promedio (ritmo central más lento), mientras que los que tienen un valor de PC2 más bajo han empleado un porcentaje de tiempo relativo menor (ritmo central más rápido).
Esta segunda componente puede recibir el nombre de centro de carrera.
Importante
Los tramos centrales que más importancia tienen en la PC2 (de los 20km a los 35km, con énfasis entre los 20km y 30km) corresponden con el “muro”, momento en el que el rendimiento disminuye muy notablemente. De esta forma, la PC2 podría reflejar una bajada de rendimiento excesiva si se ven valores muy altos. Para comprobarlo se puede acudir a elite_pca_data y observar el porcentaje de tiempo normalizado en esos tramos comparados con el resto de porcentajes de la carrera.
2.1.4 Gráfica de PCA - Élite
# Preparar datos para graficar
scores_elite <- as.data.frame(pca_elite$x[, 1:2])
scores_elite$Nombre <- elite_pca_data$Nombre
scores_elite$Genero <- elite_pca_data$Genero
scores_elite$estrategia <- elite_pca_data$estrategia
# Mostrar algunos valores
cat("\n=== PRIMEROS 10 CORREDORES EN ESPACIO PC1-PC2 ===\n")
=== PRIMEROS 10 CORREDORES EN ESPACIO PC1-PC2 ===print(head(scores_elite, 10)) PC1 PC2 Nombre Genero estrategia
1 -3.00929499 0.27091310 TADESE TAKELE Men Uniforme
2 -2.40197373 -0.27433337 DERESA GELETA Men Uniforme
3 -2.17541835 -0.45609304 VINCENT KIPKEMOI NGETICH Men Uniforme
4 -0.09199066 -0.10165290 TITUS KIPRUTO Men Positiva
5 -1.94426317 -0.36048314 MULUGETA ASEFA UMA Men Uniforme
6 -3.38502096 0.26856368 GEOFFREY TOROITICH Men Uniforme
7 0.20325598 -0.16819457 BENSON KIPRUTO Men Positiva
8 -3.21935698 -0.04320958 SULDAN HASSAN Men Uniforme
9 -1.71207172 -0.68418024 JOSHUA CHEPTEGEI Men Uniforme
10 -3.11607220 -0.08603310 TSUBASA ICHIYAMA Men UniformeEn esta lista se puede observar cómo los atletas que tienen valores más bajos en la PC1 (a partir de -1.7) son los que siguen una estrategia uniforme mientras que los que tienen valores más altos (cercanos a 0) siguen una estrategia positiva.
En cuanto a la PC2, todos los valores son bajos, muy cercanos a 0, indicando que:
Para los que han llevado una estrategia uniforme, la distribución relativa de los porcentajes de tiempo no ha sufrido grandes variaciones en ningún momento de la carrera con respecto al promedio promedio.
Para los deportistas que han llevado una estrategia positiva, la caída en el rendimiento se ha dado más cerca de los kilómetros finales (a partir de los 35) que de los intermedios, es decir, los tramos intermedios de la carrera no han sido especialmente influyentes en comparación con el promedio. Esto es coherente con sus valores de PC1 (0 comparado a los valores a partir de -1.7 de los otros atletas), pues los valores altos en PC1 reflejaban un comienzo más rápido y un final más ralentizado (menor porcentaje de tiempo relativo al principio en contraposición con el final).
Importante
No todas las estrategias presentarán los mismos valores de PC1 y PC2. Por ejemplo, un corredor puede llevar una estrategia positiva por haber disminuido su rendimiento en los tramos finales de la carrera o por haberlo disminuido en los tramos intermedios hasta la meta. En el primero de los casos, la PC2, al referirse a los kilómetros centrales, no recogería la pérdida de velocidad relativa. En el segundo, dicha pérdida se vería reflejada tanto en la PC1 y como en la PC2. La consistencia de la interpretación radica en la coherencia de cada estrategia con el significado de las componentes principales.
2.1.4.1 Gráfico estático con ggplot2
# Gráfica estática básica
ggplot(
scores_elite,
aes(x = PC1, y = PC2, color = Genero, shape = estrategia)
) +
geom_point(size = 4, alpha = 0.7) +
labs(
title = "PCA - Categoría Élite (por Género y Estrategia)",
x = paste0("PC1 (", var_explicada[1], "%)"),
y = paste0("PC2 (", var_explicada[2], "%)"),
color = "Género",
shape = "Estrategia"
) +
scale_color_manual(values = c("Men" = "#1976D2", "Women" = "#E91E63")) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14, hjust = 0.5),
panel.grid.major = element_line(color = "gray90"),
panel.grid.minor = element_blank(),
legend.position = "right"
)
2.1.4.2 Gráfico interactivo con plotly
library(plotly)
# Crear variable combinada para colores únicos por género y estrategia
scores_elite <- scores_elite %>%
mutate(grupo = paste0(Genero, " - ", estrategia))
# Definir paleta de colores combinada (género como tono base, estrategia como variación)
colores_combinados <- c(
# Hombres (tonos azules)
"Men - Negativa" = "#1E3A8A",
"Men - Positiva" = "#2563EB",
"Men - Uniforme" = "#60A5FA",
"Men - Variable" = "#93C5FD",
# Mujeres (tonos rosas/morados)
"Women - Negativa" = "#831843",
"Women - Positiva" = "#BE185D",
"Women - Uniforme" = "#EC4899",
"Women - Variable" = "#F9A8D4"
)
# Calcular rangos fijos de los ejes
rango_x <- range(scores_elite$PC1, na.rm = TRUE)
rango_y <- range(scores_elite$PC2, na.rm = TRUE)
margen_x <- diff(rango_x) * 0.1
margen_y <- diff(rango_y) * 0.1
# Crear figura base
fig <- plot_ly()
# Agregar trazas por cada combinación de género y estrategia
for (genero in unique(scores_elite$Genero)) {
for (estrat in unique(scores_elite$estrategia)) {
datos_grupo <- scores_elite %>%
filter(Genero == genero, estrategia == estrat)
if (nrow(datos_grupo) > 0) {
fig <- fig %>%
add_trace(
data = datos_grupo,
x = ~PC1,
y = ~PC2,
type = "scatter",
mode = "markers",
name = paste0(genero, " - ", estrat),
legendgroup = genero,
legendgrouptitle = list(text = genero),
marker = list(
size = 12,
color = colores_combinados[paste0(genero, " - ", estrat)],
opacity = 0.85,
line = list(
color = "white",
width = 1.5
)
),
text = ~ paste0(
"<b style='font-size:14px'>",
Nombre,
"</b><br>",
"<br>",
"<b>Género:</b> ",
Genero,
"<br>",
"<b>Estrategia:</b> ",
estrat,
"<br>",
"<br>",
"<b>PC1:</b> ",
round(PC1, 4),
"<br>",
"<b>PC2:</b> ",
round(PC2, 4)
),
hovertemplate = "%{text}<extra></extra>"
)
}
}
}
# Configurar layout con ejes fijos
fig <- fig %>%
layout(
title = list(
text = "<b>Análisis de Componentes Principales - Categoría Élite</b><br><sub>Estrategias de carrera en el Maratón de Tokio 2025</sub>",
font = list(
size = 18,
family = "Arial, sans-serif",
color = "#2C3E50"
),
x = 0.5,
xanchor = "center"
),
xaxis = list(
title = list(
text = paste0("<b>PC1 (", var_explicada[1], "%)</b>"),
font = list(size = 14, family = "Arial", color = "#34495E")
),
range = c(rango_x[1] - margen_x, rango_x[2] + margen_x),
fixedrange = FALSE,
gridcolor = "#E8E8E8",
gridwidth = 1,
showgrid = TRUE,
zeroline = TRUE,
zerolinecolor = "#95A5A6",
zerolinewidth = 2,
tickfont = list(size = 11, color = "#34495E")
),
yaxis = list(
title = list(
text = paste0("<b>PC2 (", var_explicada[2], "%)</b>"),
font = list(size = 14, family = "Arial", color = "#34495E")
),
range = c(rango_y[1] - margen_y, rango_y[2] + margen_y),
fixedrange = FALSE,
gridcolor = "#E8E8E8",
gridwidth = 1,
showgrid = TRUE,
zeroline = TRUE,
zerolinecolor = "#95A5A6",
zerolinewidth = 2,
tickfont = list(size = 11, color = "#34495E")
),
hovermode = "closest",
hoverlabel = list(
bgcolor = "white",
font = list(
family = "Arial, sans-serif",
size = 13,
color = "#2C3E50"
),
bordercolor = "#BDC3C7",
align = "left"
),
legend = list(
title = list(
text = "<b>Género y Estrategia</b>",
font = list(size = 13, family = "Arial")
),
font = list(size = 11, family = "Arial"),
orientation = "v",
x = 1.02,
y = 1,
bgcolor = "rgba(255, 255, 255, 0.95)",
bordercolor = "#BDC3C7",
borderwidth = 1,
tracegroupgap = 10
),
plot_bgcolor = "#FAFAFA",
paper_bgcolor = "#FFFFFF",
margin = list(l = 80, r = 180, t = 100, b = 80)
) %>%
config(
displayModeBar = TRUE,
displaylogo = FALSE,
modeBarButtonsToRemove = c("lasso2d", "select2d"),
toImageButtonOptions = list(
format = "png",
filename = "pca_elite_tokyo2025",
height = 800,
width = 1200,
scale = 2
)
)
# Mostrar gráfico
figEn estas gráficas se representa lo que se exponía con anterioridad dibujando cada atleta en dos dimensiones. El atleta es cada uno de los puntos de la gráfica. El color distingue su género, y la forma del punto (en la primera gráfica) o la intensidad del color (en la segunda gráfica) indican la estrategia que ha llevado a cabo. Las dos dimensiones son las dos componentes principales.
La mayoría de los puntos que están a la derecha del 0 en la PC1 son los deportistas que llevaron una estrategia positiva, independitentemente de los valores de la PC2. Los que corrieron de forma uniforme se sitúan a la izquierda del 0 en la PC1 y cerca del 0 en la PC2. Además, los que tienen valores más bajos en la PC1 son también los que más cerca se situán del valor 0 de la PC2.
Resulta llamativo que la mayoría de mujeres tuvieron menos variabilidad en el ritmo relativo que los hombres, hecho que también se observó durante el EDA al comparar las estrategias. Podría deberse a la mayor proporción de fibras tipo I (las más resistentes) del organismo femenino con respecto al masculino (citar).
2.1.5 Respondiendo preguntas
Con este PCA se puede responder a la pregunta formulada al final del EDA “¿En qué momento o momentos hay un cambio notable en el ritmo de los atletas?”. Se ha visto que en función de los valores en PC1 y PC2 se puede estimar la zona de la carrera en la que el cambio en el rendimiento, si lo hubo, fue remarcable. En los 10 atletas de élite que se han tomado de ejemplo antes de elaborar las gráficas, solo 2 aumentaron su porcentaje de tiempo relativo a partir de un determinado tramo. En estos casos fue a partir del kilómetro 35. Esta variación relativa refleja un cambio de ritmo significativo a falta de 7km y 195m para terminar la carrera.
3 Clustering
¿Sería interesante? Para diferenciar dentro de la élite los grupos que hay en función de las estrategias. Ver correlaciones entre el número de ganadores o TOP3 en cada grupo estratégico. Usar estas correlaciones y papers para respaldar con metodos estadísticos la evidencia de que estrategia uniforme es mejor para la maraton.
4 Modelo de regresión lineal para predecir el tiempo de la maratón
En vez de usar todo esto, usar las dimensiones del PCA para predecir el tiempo de la maratón? O se pueden hacer las dos cosas?
- con los parciales hasta la media maratón
- con los tiempos desde la media maratón
- con los parciales hasta la media maratón teniendo en cuenta la edad
- con los parciales desde la media maratón teniendo en cuenta la edad
- teniéndolo todo en cuenta
names(resultadosTokyo2025) [1] "BIB" "Nombre" "Nacionalidad"
[4] "Genero" "Edad" "tiempo_oficial"
[7] "parcial_5km" "parcial_10km" "parcial_15km"
[10] "parcial_20km" "medio_maraton" "parcial_25km"
[13] "parcial_30km" "parcial_35km" "parcial_40km"
[16] "Pais_Estandarizado" "CODE" "ritmo_oficial"
[19] "ritmo_5km" "ritmo_10km" "ritmo_15km"
[22] "ritmo_20km" "ritmo_25km" "ritmo_30km"
[25] "ritmo_35km" "ritmo_40km" "categoria"
[28] "grupo_edad" "estrategia" "TPI" modelo_parcial_hasta_mm <- lm(tiempo_oficial ~ parcial_5km + parcial_10km + parcial_15km + parcial_20km, medio_maraton,
data = resultadosTokyo2025)
summary(modelo_parcial_hasta_mm)
Call:
lm(formula = tiempo_oficial ~ parcial_5km + parcial_10km + parcial_15km +
parcial_20km, data = resultadosTokyo2025, subset = medio_maraton)
Residuals:
Min 1Q Median 3Q Max
-1526.91 -298.80 -33.27 246.49 2277.60
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5914.21818 43.82511 134.950 < 2e-16 ***
parcial_5km 0.68045 0.11783 5.775 7.77e-09 ***
parcial_10km 0.74847 0.13279 5.637 1.75e-08 ***
parcial_15km -2.57198 0.12101 -21.255 < 2e-16 ***
parcial_20km 2.62573 0.06379 41.159 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 416 on 36159 degrees of freedom
Multiple R-squared: 0.4465, Adjusted R-squared: 0.4465
F-statistic: 7293 on 4 and 36159 DF, p-value: < 2.2e-16par(mfrow = c(2, 2)) # 4 gráficos en una misma ventana
plot(modelo_parcial_hasta_mm)
par(mfrow = c(1, 1))pred <- predict(modelo_parcial_hasta_mm)
plot(resultadosTokyo2025$tiempo_oficial, pred,
xlab = "Tiempo real",
ylab = "Tiempo predicho",
main = "Predicción vs Real - modelo_parcial_hasta_mm")
abline(0, 1, col="red", lwd=2) # línea ideal
library(ggplot2)
resultadosTokyo2025$pred <- predict(modelo_parcial_hasta_mm)
ggplot(resultadosTokyo2025, aes(x = pred, y = tiempo_oficial)) +
geom_point() +
geom_abline(intercept = 0, slope = 1, color = "red") +
labs(title = "Predicciones vs valores reales - Modelo A",
x = "Tiempo predicho",
y = "Tiempo real") +
theme_minimal()
5 Modelo de Regresión Logística para predecir si dará un bajón muy grande a partir del km 30
# PREPARACIÓN DE LOS DATOS
# Eliminar cartegoria No élite
df <- resultadosTokyo2025 %>%
filter(categoria != "No élite") %>%
mutate(categoria = droplevels(as.factor(categoria)))
unique(df$categoria)[1] Élite Alto nivel Muy entrenado
[4] Moderadamente entrenado Principiante
5 Levels: Élite Alto nivel Muy entrenado ... Principiante# Encoding variable (categoria: Élite, Alto nivel, Muy entrenado, Moderadamente entrenado, Principiante)
df <- df %>%
mutate(
categoria_encoded = case_when(
categoria == "Élite" ~ 4,
categoria == "Alto nivel" ~ 3,
categoria == "Muy entrenado" ~ 2,
categoria == "Moderadamente entrenado" ~ 1,
categoria == "Principiante" ~ 0
)
)
# Pasar a segundos los ritmos
# Calcular parciales reales (tiempos de cada segmento)
df <- df %>%
mutate(
seg_0_5 = parcial_5km,
seg_5_10 = parcial_10km - parcial_5km,
seg_10_15 = parcial_15km - parcial_10km,
seg_15_20 = parcial_20km - parcial_15km,
seg_20_25 = parcial_25km - parcial_20km,
seg_25_30 = parcial_30km - parcial_25km,
seg_30_35 = parcial_35km - parcial_30km,
seg_35_40 = parcial_40km - parcial_35km,
seg_40_meta = tiempo_oficial - parcial_40km
)
# Normalizar por tiempo oficial (porcentaje de tiempo en cada segmento)
df <- df %>%
mutate(
rel_seg_0_5 = seg_0_5 / tiempo_oficial,
rel_seg_5_10 = seg_5_10 / tiempo_oficial,
rel_seg_10_15 = seg_10_15 / tiempo_oficial,
rel_seg_15_20 = seg_15_20 / tiempo_oficial,
rel_seg_20_25 = seg_20_25 / tiempo_oficial,
rel_seg_25_30 = seg_25_30 / tiempo_oficial,
rel_seg_30_35 = seg_30_35 / tiempo_oficial,
rel_seg_35_40 = seg_35_40 / tiempo_oficial,
rel_seg_40_meta = seg_40_meta / tiempo_oficial
)
# Crear variable objetivo: bajón muy grande a partir del km 30
# Bonk = 1 si el corredor tiene un ritmo relativo mayor al 12% en alguno de los segmentos posteriores al km 30
df <- df %>%
mutate(
bonk = ifelse(
(rel_seg_30_35 > 0.12) |
(rel_seg_35_40 > 0.14) |
(rel_seg_40_meta > 0.12),
1,
0
)
)
# Visualizar categorias y bonk
table(df$categoria, df$bonk)
0 1
Élite 16 76
Alto nivel 82 151
Muy entrenado 889 1080
Moderadamente entrenado 2117 2438
Principiante 7536 21741# Seleccionar variables para el modelo
model_data <- df %>%
select(
bonk,
categoria_encoded,
rel_seg_0_5,
rel_seg_5_10,
rel_seg_10_15,
rel_seg_15_20,
rel_seg_20_25,
rel_seg_25_30
)# Dividir en conjunto de entrenamiento y prueba
set.seed(123)
train_index <- createDataPartition(model_data$bonk, p = 0.8, list = FALSE)
train_data <- model_data[train_index, ]
test_data <- model_data[-train_index, ]
# MODELO DE REGRESIÓN LOGÍSTICA
logistic_model <- glm(
bonk ~ .,
data = train_data,
family = binomial(link = "logit")
)
# Resumen del modelo
cat("=== RESUMEN MODELO DE REGRESIÓN LOGÍSTICA ===\n")=== RESUMEN MODELO DE REGRESIÓN LOGÍSTICA ===summary(logistic_model)
Call:
glm(formula = bonk ~ ., family = binomial(link = "logit"), data = train_data)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 35.4800 0.6573 53.98 <2e-16 ***
categoria_encoded 1.0857 0.0307 35.37 <2e-16 ***
rel_seg_0_5 -55.4389 3.5831 -15.47 <2e-16 ***
rel_seg_5_10 -82.9637 4.8306 -17.17 <2e-16 ***
rel_seg_10_15 -80.4229 3.4707 -23.17 <2e-16 ***
rel_seg_15_20 -93.3691 3.3657 -27.74 <2e-16 ***
rel_seg_20_25 -68.5322 3.6295 -18.88 <2e-16 ***
rel_seg_25_30 55.3181 3.5000 15.80 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 35075 on 28900 degrees of freedom
Residual deviance: 23117 on 28893 degrees of freedom
AIC: 23133
Number of Fisher Scoring iterations: 6# Predicciones en el conjunto de prueba
test_data$predicted_prob <- predict(logistic_model, newdata = test_data, type = "response")
test_data$predicted_class <- ifelse(test_data$predicted_prob > 0.5, 1, 0)
# Evaluación del modelo
confusion_matrix <- table(test_data$bonk, test_data$predicted_class)
cat("\n=== MATRIZ DE CONFUSIÓN ===\n")
=== MATRIZ DE CONFUSIÓN ===print(confusion_matrix)
0 1
0 1336 770
1 583 4536